﻿Imports System.Text

Public Class JSONTokener
    ''' <summary>输入JSON </summary>
    Private input As String
    ''' <summary>返回的下一个字符的索引。当输入用尽时，这等于输入的长度。</summary>
    Private pos As Integer
    ''' <summary>
    ''' 构造函数
    ''' </summary>
    ''' <param name="json">JSON编码字符串。不允许Null，它将产生一个令牌，在调用方法时抛出<code>Exceptions</code>。</param>
    ''' <remarks></remarks>
    Public Sub New(ByVal json As String)
        If Not IsNothing(json) Then
            '如果存在，则使用可选的字节顺序标记（BOM）。
            If json.StartsWith((Chr(254) + Chr(255))) Then   '"﻿﻿\ufeff"
                json = json.Substring(1)
            End If
        End If
        Me.input = json
    End Sub
    ''' <summary>
    ''' 返回输入的下一个值。
    ''' </summary>
    ''' <returns>
    ''' <code>JSONObject</code>、<code>JSONArray</code>、String、Boolean、Integer、Long、Double或<code>JSONObject.NULL</code>。
    ''' </returns>
    ''' <remarks></remarks>
    ''' <exception cref="Exception"></exception>
    Public Function NextValue() As Object
        Dim c As Integer = NextCleanInternal()
        Select Case c
            Case -1
                Throw syntaxError("End of input")
            Case Asc("{")
                Return ReadObject()
            Case Asc("[")
                Return ReadArray()
            Case Asc("'"), Asc("""")
                Return NextString(Chr(c))
            Case Else
                pos -= 1
                Return ReadLiteral()
        End Select
    End Function

    Private Function NextCleanInternal() As Integer
        While pos < input.Length
            Dim c As Char = input.Chars(pos)
            pos += 1
            Select Case c
                Case vbTab, " ", vbLf, vbCr
                    Continue While
                Case "/"
                    If pos = input.Length Then
                        Return Asc(c)
                    End If
                    Dim peek As Char = input.Chars(pos)
                    Select Case peek
                        Case "*"
                            '跳过/*C样式的注释*/
                            pos += 1
                            Dim commentEnd As Integer = input.IndexOf("*/", pos)
                            If commentEnd = -1 Then
                                Throw syntaxError("Unterminated comment")
                            End If
                            pos = commentEnd + 2
                            Continue While
                        Case "/"
                            pos += 1
                            SkipToEndOfLine()
                            Continue While
                        Case Else
                            Return Asc(c)
                    End Select
                Case "#"
                    '跳过#散列行尾注释。JSON RFC没有指定这种行为，但是需要解析现有文档。参见：http://b/2571423。
                    SkipToEndOfLine()
                    Continue While
                Case Else
                    Return Asc(c)
            End Select
        End While
        Return -1
    End Function
    ''' <summary>
    ''' 将位置前进到下一个换行符之后。如果该行以"\r\n"结尾，则调用者必须将"\n"用作空白。
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub SkipToEndOfLine()
        Do While pos < input.Length
            Dim c As Char = input.Chars(pos)
            If c = vbCr Or c = vbLf Then
                pos += 1
                Exit Do
            End If
            pos += 1
        Loop
    End Sub
    ''' <summary>
    ''' 返回到但不包括<code>quote</code>的字符串，不跳过沿途遇到的任何字符转义序列。开场白应该已经读过了。这将使用结束引号，但不会将其包含在返回的字符串中。
    ''' </summary>
    ''' <param name="quote">'或"</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function NextString(ByVal quote As Char) As String
        '对于没有转义序列的字符串，我们可以将结果提取为输入的子字符串。但如果遇到转义序列，则需要使用StringBuilder来合成结果。
        Dim builder As StringBuilder = Nothing
        '尚未附加到生成器的第一个字符的索引
        Dim start As Integer = pos
        While pos < input.Length
            Dim c As Char = input.Chars(pos)
            pos += 1
            If c = quote Then
                If IsNothing(builder) Then
                    '新字符串避免内存泄漏
                    Return New String(input.Substring(start, (pos - 1) - start))
                Else
                    builder.Append(input, start, pos - 1)
                    Return builder.ToString()
                End If
            End If
            If c = "\" Then
                If pos = input.Length Then
                    Throw syntaxError("Unterminated escape sequence")
                End If
                If IsNothing(builder) Then
                    builder = New StringBuilder()
                End If
                builder.Append(input, start, pos - 1)
                builder.Append(ReadEscapeCharacter())
                start = pos
            End If
        End While
        Throw syntaxError("Unterminated string")
    End Function
    ''' <summary>
    ''' 取消由紧跟在反斜杠后面的一个或多个字符标识的字符。应该已经读取了反斜杠“\”。这支持unicode转义“u000A”和两个字符转义“\n”。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadEscapeCharacter() As Char
        Dim escaped As Char = input.Chars(pos)
        pos += 1
        Select Case escaped
            Case "u"
                If pos + 4 > input.Length Then
                    Throw syntaxError("Unterminated escape sequence")
                End If
                Dim hex As String = input.Substring(pos, 4)
                pos += 4
                Try
                    Return Chr(Integer.Parse(hex, 16))
                Catch ex As Exception
                    Throw syntaxError("Invalid escape sequence: " + hex)
                End Try
            Case "t"
                Return vbTab
            Case "b"
                Return vbBack
            Case "n"
                Return vbLf
            Case "r"
                Return vbCr
            Case "f"
                Return vbFormFeed
            Case "'", """", "\"
                Return escaped
            Case Else
                Return escaped
        End Select
    End Function
    ''' <summary>
    ''' 读取空值、布尔值、数值或无引号的字符串文本值。数值将以整数、Long或Double的形式按优先顺序返回。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadLiteral() As Object
        Dim literal As String = NextToInternal("{}[]/\:,=;# tf")
        If literal.Length = 0 Then
            Throw syntaxError("Expected literal value")
        ElseIf literal.ToLower = "null" Then
            Return "null"
        ElseIf literal.ToLower = "true" Then
            Return "true"
        ElseIf literal.ToLower = "false" Then
            Return "false"
        End If
        '尝试作为整型进行分析
        If literal.IndexOf(".") = -1 Then
            Dim base As Integer = 10
            Dim number As String = literal
            If (number.StartsWith("0x") Or number.StartsWith("0X")) Then
                number = number.Substring(2)
                base = 16
            ElseIf (number.StartsWith("0") And number.Length() > 1) Then
                number = number.Substring(1)
                base = 8
            End If
            Try
                Dim longValue As Long = Long.Parse(number, base)
                If longValue <= Integer.MaxValue And longValue >= Integer.MinValue Then
                    Return CInt(longValue)
                Else
                    Return longValue
                End If
            Catch ex As Exception
                '这只发生在大于长最大值，指数形式的数字（5e-10）和不带引号的字符串。尝试浮点运算。
            End Try
        End If
        Try
            Return Double.Parse(literal)
        Catch ex As Exception
        End Try
        '最后放弃。我们有一个未引号的字符串
        Return New String(literal) '新字符串可避免内存泄漏
    End Function
    ''' <summary>
    ''' 返回字符串，但不包括给定字符或换行符中的任何字符。这不会消耗被排除的字符。
    ''' </summary>
    ''' <param name="excluded"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function NextToInternal(excluded As String) As String
        Dim start As Integer = pos
        Do While pos < input.Length
            Dim c As Char = input.Chars(pos)
            If c = vbCr Or c = vbLf Or excluded.IndexOf(c) <> -1 Then
                'Substring(start, pos)修改为下面。因为在net中Substring（开始，长度），java中Substring（开始，结束）,所以这里应该是用结束位置-开始位置
                Return input.Substring(start, pos - start)
            End If
            pos += 1
        Loop
        Return input.Substring(start)
    End Function
    ''' <summary>
    ''' 读取对象的键/值对序列和尾随右大括号'}'。应该已经读取了左大括号“{”。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadObject() As JSONObject
        Dim result As JSONObject = New JSONObject()
        Dim first As Integer = NextCleanInternal()
        If Chr(first) = "}" Then
            Return result
        ElseIf first <> -1 Then
            pos -= 1
        End If
        While True
            Dim name As Object = NextValue()
            If Not name.GetType.Equals(GetType(String)) Then
                If IsNothing(name) Then
                    Throw syntaxError("Names cannot be null")
                Else
                    Throw syntaxError("Names must be strings, but " + name.ToString + " is of type " + name.GetType.Name)
                End If
            End If
            Dim separator As Integer = NextCleanInternal()
            If Chr(separator) <> ":" And Chr(separator) <> "=" Then
                Throw syntaxError("Expected ':' after " + name)
            End If
            If pos < input.Length Then
                If input.Chars(pos) = ">" Then
                    pos += 1
                End If
            End If
            result.put(name, NextValue())
            Dim ci As Integer = NextCleanInternal()
            Select Case ci
                Case Asc("}")
                    Return result
                Case Asc(";"), Asc(",")
                    Continue While
                Case Else
                    Throw syntaxError("Unterminated object")
            End Select
        End While
        Return result
    End Function
    ''' <summary>
    ''' 读取数组的值序列和尾随右大括号']'。应该已经读取了左大括号“[”。注意，“[]”产生一个空数组，但是“[，]”返回一个与“[null，null]”等价的两元素数组。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ReadArray() As Object
        Dim result As JSONArray = New JSONArray()
        Dim hasTrailingSeparator As Boolean = False
        While True
            Dim ci As Integer = NextCleanInternal()
            Select Case ci
                Case -1
                    Throw syntaxError("Unterminated array")
                Case Asc("]")
                    If hasTrailingSeparator Then
                        Dim obj As Object = Nothing
                        result.put(obj)
                    End If
                    Return result
                Case Asc(","), Asc(";")
                    '没有值的分隔符首先表示“null”。
                    Dim obj As Object = Nothing
                    result.put(obj)
                    hasTrailingSeparator = True
                    Continue While
                Case Else
                    pos -= 1
            End Select
            result.put(NextValue())
            ci = NextCleanInternal()
            Select Case ci
                Case Asc("]")
                    Return result
                Case Asc(","), Asc(";")
                    hasTrailingSeparator = True
                    Continue While
                Case Else
                    Throw syntaxError("Unterminated array")
            End Select
        End While
        Return result
    End Function

    Private Function syntaxError(ByVal message As String) As Exception
        Return New Exception(message + Me.GetType.Name)
    End Function
    ''' <summary>
    ''' 返回当前位置和整个输入字符串。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overrides Function toString() As String
        Return " at character " + pos + " of " + input
    End Function
    ''' <summary>
    ''' 返回true，直到输入用尽为止。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function more() As Boolean
        Return pos < input.Length()
    End Function
    ''' <summary>
    ''' 返回下一个可用字符，如果已用尽所有输入，则返回空字符“\0”。对于包含字符“\0”的JSON字符串，此方法的返回值不明确。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextChar() As Char
        Dim result As Char = IIf(pos < input.Length(), input.Chars(pos), Chr(0))
        pos += 1
        Return result
    End Function
    ''' <summary>
    ''' 如果下一个可用字符等于<code>c</code>，则返回该字符。否则会引发异常。
    ''' </summary>
    ''' <param name="c"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextChar(ByVal c As Char) As Char
        Dim result As Char = nextChar()
        If result <> c Then
            Throw syntaxError("Expected " + c + " but was " + result)
        End If
        Return result
    End Function
    ''' <summary>
    ''' 返回下一个非空白且不属于注释的字符。如果在找到这样一个字符之前输入已用尽，则返回空字符'\0'。对于包含字符“\0”的JSON字符串，此方法的返回值不明确。
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextClean() As Char
        Dim nextCleanInt As Integer = NextCleanInternal()
        Return IIf(nextCleanInt = -1, Chr(0), Chr(nextCleanInt))
    End Function
    ''' <summary>
    ''' 返回输入的下一个{@code length}字符。
    ''' 返回的字符串与此标记器的输入字符串共享其支持字符数组。
    ''' 如果对返回字符串的引用可能被无限保留，那么应该首先使用{@code new string（result）}复制它，
    ''' 以避免内存泄漏。
    ''' </summary>
    ''' <param name="length"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextString(ByVal length As Integer) As String
        If pos + length > input.Length Then
            Throw syntaxError(length + " is out of bounds")
        End If
        Dim result As String = input.Substring(pos, length)
        pos += length
        Return result
    End Function
    ''' <summary>
    ''' 返回{@link String#trim trimmed}字符串，其中包含最多但不包括以下第一个字符：
    ''' {@code excluded}中的任何字符
    ''' 换行符“\n”
    ''' 回车“\r”
    ''' 返回的字符串与此标记器的输入字符串共享其支持字符数组。
    ''' 如果对返回字符串的引用可能被无限期保留，那么应该首先
    ''' 使用{@code new string（result）}复制它，以避免内存泄漏。
    ''' </summary>
    ''' <param name="excluded"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextStringTo(ByVal excluded As String) As String
        If excluded Is Nothing Then
            Throw New Exception("excluded == null")
        End If
        Return NextToInternal(excluded).Trim()
    End Function
    ''' <summary>
    ''' 相当于{@code nextStringTo(String.valueOf值（不包括在内）。
    ''' </summary>
    ''' <param name="excluded"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function nextCharTo(ByVal excluded As Char) As String
        Return NextToInternal(excluded)
    End Function
    ''' <summary>
    ''' 将所有输入向前推进，直到并包括下一次出现的{@code thru}。如果剩余的输入不包含{@code thru}，则输入将用尽。
    ''' </summary>
    ''' <param name="thru"></param>
    ''' <remarks></remarks>
    Public Sub skipPast(ByVal thru As String)
        Dim thruStart As Integer = input.IndexOf(thru, pos)
        pos = IIf(thruStart = -1, input.Length(), (thruStart + thru.Length()))
    End Sub
    ''' <summary>
    ''' 超过所有输入，但不包括下一次出现的{@code to}。如果剩余的输入不包含{@code to}，则输入不变。
    ''' </summary>
    ''' <param name="charto"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function skipTo(ByVal charto As Char) As Char
        Dim index As Integer = input.IndexOf(charto, pos)
        If index <> -1 Then
            pos = index
            Return charto
        Else
            Return Chr(Asc(0))
        End If
    End Function
    ''' <summary>
    ''' 未读输入的最新字符。如果没有读取输入字符，则输入不变。
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub back()
        pos -= 1
        If (pos = -1) Then
            pos = 0
        End If
    End Sub
    ''' <summary>
    ''' 对于给定的十六进制字符，返回整数[0..15]值；对于非十六进制输入，返回-1。
    ''' </summary>
    ''' <param name="hex">在[0-9]、[a-F]或[a-f]范围内的字符。任何其他字符将产生-1结果。</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function dehexchar(ByVal hex As Char) As Integer
        ' Dim zero As Char = "0"
        Dim intHex As Integer = Asc(hex)
        If intHex >= Asc("0") And intHex <= Asc("0") Then
            Return Asc(hex) - Asc("0")
        ElseIf intHex >= Asc("A") And intHex <= Asc("F") Then
            Return Asc(hex) - Asc("A") + 10
        ElseIf intHex >= Asc("a") And intHex <= Asc("f") Then
            Return Asc(hex) - Asc("a") + 10
        Else
            Return -1
        End If
    End Function
End Class
